home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / mwheel / MWTEST5.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-08-15  |  5.2 KB  |  159 lines
  1. VERSION 5.00
  2. Object = "{94C8DA1F-FDF5-11D0-BB7C-0055003B26DE}#1.0#0"; "mwheel.ocx"
  3. Begin VB.Form frmMWTest 
  4.    Caption         =   "Form1"
  5.    ClientHeight    =   7230
  6.    ClientLeft      =   60
  7.    ClientTop       =   345
  8.    ClientWidth     =   5700
  9.    Icon            =   "MWTest5.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   7230
  12.    ScaleWidth      =   5700
  13.    StartUpPosition =   3  'Windows Default
  14.    Begin MouseWheelOCX.MouseWheel MouseWheel1 
  15.       Left            =   4560
  16.       Top             =   180
  17.       _ExtentX        =   847
  18.       _ExtentY        =   847
  19.    End
  20.    Begin VB.VScrollBar VScroll1 
  21.       Height          =   6135
  22.       LargeChange     =   25
  23.       Left            =   5340
  24.       Max             =   500
  25.       SmallChange     =   5
  26.       TabIndex        =   6
  27.       Top             =   960
  28.       Width           =   255
  29.    End
  30.    Begin VB.HScrollBar HScroll1 
  31.       Height          =   255
  32.       LargeChange     =   25
  33.       Left            =   60
  34.       Max             =   -500
  35.       SmallChange     =   5
  36.       TabIndex        =   5
  37.       Top             =   6840
  38.       Width           =   5115
  39.    End
  40.    Begin VB.OptionButton Option1 
  41.       Caption         =   "ControlUnderMouse"
  42.       Height          =   195
  43.       Index           =   1
  44.       Left            =   2220
  45.       TabIndex        =   2
  46.       Top             =   540
  47.       Width           =   1935
  48.    End
  49.    Begin VB.OptionButton Option1 
  50.       Caption         =   "ControlWithFocus"
  51.       Height          =   195
  52.       Index           =   0
  53.       Left            =   120
  54.       TabIndex        =   1
  55.       Top             =   540
  56.       Width           =   1935
  57.    End
  58.    Begin VB.CheckBox Check1 
  59.       Caption         =   "Turn on Notifications"
  60.       Height          =   195
  61.       Left            =   120
  62.       TabIndex        =   0
  63.       Top             =   180
  64.       Width           =   3555
  65.    End
  66.    Begin VB.ListBox List1 
  67.       Height          =   2820
  68.       IntegralHeight  =   0   'False
  69.       Left            =   60
  70.       Sorted          =   -1  'True
  71.       TabIndex        =   4
  72.       Top             =   3900
  73.       Width           =   5115
  74.    End
  75.    Begin VB.TextBox Text1 
  76.       Height          =   2835
  77.       Left            =   60
  78.       MultiLine       =   -1  'True
  79.       ScrollBars      =   3  'Both
  80.       TabIndex        =   3
  81.       Text            =   "MWTest5.frx":000C
  82.       Top             =   960
  83.       Width           =   5115
  84.    End
  85. Attribute VB_Name = "frmMWTest"
  86. Attribute VB_GlobalNameSpace = False
  87. Attribute VB_Creatable = False
  88. Attribute VB_PredeclaredId = True
  89. Attribute VB_Exposed = False
  90. Option Explicit
  91. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
  92. Private Sub MouseWheel1_AfterMouseWheel(ByVal hWnd As Long, ByVal Delta As Long, ByVal Shift As Long, ByVal Button As Long, ByVal x As Long, ByVal y As Long)
  93.    Select Case hWnd
  94.       Case Me.hWnd, Option1(0).hWnd, Option1(1).hWnd
  95.          If Option1(0).Value Then
  96.             Option1(1).Value = True
  97.          Else
  98.             Option1(0).Value = True
  99.          End If
  100.       Case Check1.hWnd
  101.          Check1.Value = Abs(Not CBool(Check1.Value))
  102.    End Select
  103. End Sub
  104. Private Sub MouseWheel1_BeforeMouseWheel(ByVal hWnd As Long, ByVal Delta As Long, ByVal Shift As Long, ByVal Button As Long, ByVal x As Long, ByVal y As Long, Cancel As Boolean)
  105.    Call UpdateCaption
  106.    Select Case hWnd
  107.       Case Text1.hWnd
  108.          If Button = vbMiddleButton Then
  109.             Call MouseWheel1.HorzScroll(hWnd, Delta)
  110.             Cancel = True
  111.          End If
  112.    End Select
  113. End Sub
  114. Private Sub UpdateCaption()
  115.    ' Query for current number of scrolllines
  116.    MouseWheel1.Refresh
  117.    If MouseWheel1.ScrollLines = -1 Then
  118.       Me.Caption = "ScrollLines: WHEEL_PAGESCROLL"
  119.    Else
  120.       Me.Caption = "ScrollLines: " & MouseWheel1.ScrollLines
  121.    End If
  122. End Sub
  123. Private Sub Check1_Click()
  124.    ' Turn on notification for these windows.
  125.    ' Only required in WinNT.
  126.    MouseWheel1.hWndNotify(Text1.hWnd) = CBool(Check1.Value)
  127.    MouseWheel1.hWndNotify(List1.hWnd) = CBool(Check1.Value)
  128. End Sub
  129. Private Sub Form_Load()
  130.    Dim i As Long, p As String
  131.    Dim f As String
  132.    ' Show form so it looks like something's happening
  133.    Me.Move (Screen.Width - Me.ScaleWidth) / 2, (Screen.Height - Me.ScaleHeight) / 2
  134.    Me.Show
  135.    Me.Refresh
  136.    Me.MousePointer = vbHourglass
  137.    ' Fill text boxes with "stuff"
  138.    Open Environ("windir") & "\win.ini" For Binary As #1
  139.    Text1.Text = Input(LOF(1), 1)
  140.    Close #1
  141.    Text1.Refresh
  142.    ' Fill listbox with "stuff"
  143.    f = Dir(Environ("windir") & "\*.*")
  144.    Do While Len(f)
  145.       List1.AddItem f
  146.       f = Dir
  147.    Loop
  148.    List1.Refresh
  149.    ' Turn on mouse wheel notification, and caption
  150.    Call UpdateCaption
  151.    Check1.Value = vbChecked
  152.    Option1(0).Value = True
  153.    Me.MousePointer = vbDefault
  154. End Sub
  155. Private Sub Option1_Click(Index As Integer)
  156.    ' Toggle ScrollWhich property
  157.    MouseWheel1.ScrollWhich = Index
  158. End Sub
  159.